VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False


Private Type POINTAPI
        X As Long
        y As Long
End Type

Private Type Rect
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Public Ownerform As Form


Private Declare Function PtInRect Lib "user32" (lpRect As Rect, ByVal ptX As Long, ByVal pty As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal y As Long, ByVal wOptions As Long, lpRect As Rect, ByVal lpString As String, ByVal nCount As Long, lpDx As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As Rect) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

Private Const TA_CENTER = 6
Private Const ETO_OPAQUE = 2
Private Const ETO_GRAYED = 1
Private Const ETO_CLIPPED = 4

Private Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As Rect, ByVal un1 As Long, ByVal un2 As Long) As Long
Private Type Size
        cx As Long
        cy As Long
End Type



Private Declare Function DrawCaption Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long, pcRect As Rect, ByVal un As Long) As Long
Private Declare Function GetTextExtentPoint Lib "gdi32" Alias "GetTextExtentPointA" (ByVal hdc As Long, ByVal lpszString As String, ByVal cbString As Long, lpSize As Size) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As Rect, ByVal hBrush As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function Fillrect Lib "user32" Alias "FillRect" (ByVal hdc As Long, lpRect As Rect, ByVal hBrush As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long


Rem ------- Edge
Private Enum edge
BDR_RAISEDOUTER = &H1
BDR_SUNKENOUTER = &H2
BDR_RAISEDINNER = &H4
BDR_SUNKENINNER = &H8
BDR_OUTER = &H3
BDR_INNER = &HC
BDR_RAISED = &H5
BDR_SUNKEN = &HA
EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
End Enum

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Const BF_LEFT = &H1
Private Const BF_TOP = &H2
Private Const BF_RIGHT = &H4
Private Const BF_BOTTOM = &H8

Private Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
Private Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
Private Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
Private Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)

Private Const BF_DIAGONAL = &H10

' For diagonal lines, the BF_RECT flags specify the end point of
' the vector bounded by the rectangle parameter.
Private Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP Or BF_RIGHT)
Private Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP Or BF_LEFT)
Private Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM Or BF_LEFT)
Private Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM Or BF_RIGHT)

Private Const BF_MIDDLE = &H800    ' Fill in the middle.
Private Const BF_SOFT = &H1000     ' Use for softer buttons.
Private Const BF_ADJUST = &H2000   ' Calculate the space left over.
Private Const BF_FLAT = &H4000     ' For flat rather than 3-D borders.
Private Const BF_MONO = &H8000     ' For monochrome borders.
Rem --edge
Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As Rect, ByVal edge As Long, ByVal grfFlags As Long) As Boolean
Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long




'Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long



Private Const SRCAND = &H8800C6

Private Const SRCCOPY = &HCC0020

Private Const SRCERASE = &H440328

Private Const SRCINVERT = &H660046

Private Const SRCPAINT = &HEE0086

Public Enum Scroll_Direction
Vertical = 1
Horizontal = 0
End Enum

Public Enum Lense_Shape
Custom_ = 1
Circle_ = 2
Wide_Screen = 3         'this will Change your Height setting slightly
End Enum


Public Pos_Top As Long
Public Pos_Left As Long
Public Pos_Width As Long
Public Pos_Height As Long
Public Scrolling As Scroll_Direction

Public Thum_Height As Long
Public Thum_Width As Long
Public AutoRepeat As Boolean
Public ThumCount As Long
Public Lens_Shape As Lense_Shape

Public ProjectTo As Long
Public ProjectOn As Boolean
Private ThumbPics() As String
Private Loaded_Count As Long
Private LoadedPics() As StdPicture

Private Stop_Film As Boolean
Function Pic_ADD(Filename As String)
Loaded_Count = Loaded_Count + 1
ReDim Preserve ThumbPics(Loaded_Count)
ThumbPics(Loaded_Count) = Filename
End Function
Function Pic_DEL(Position As Long)

Dim tmp() As String
For X = 1 To LoadedCount
If X = Position Then GoTo Bp:
NI = NI + 1
tmp(NI) = ThumbPics(X)
Bp:
Next X

ReDim ThumbPics(NI)

For X = 1 To NI
ThumbPics(X) = tmp(NI)
Next X
Loaded_Count = NI
Erase tmp
End Function

Function Roll_Tape(Optional StartThumb As Long, Optional EndThumb As Long)
If Stop_Film = True Then Form1.Cls

Dim Current_Cell As Rect
Dim tmp As Long
Dim X As Long
Dim Curpos As Long

'Current_Cell.Left = Me.Pos_Left
'Current_Cell.Right = Me.Pos_Width
'Current_Cell.Bottom = Me.Pos_Height
'Current_Cell.Top = Me.Pos_Top
If starthumb = 0 Then StartThumb = 1
If EndThumb = 0 Then EndThumb = Me.ThumCount
For tmp = 1 To Loaded_Count
memdc = CreateCompatibleDC(Ownerform.hdc)
Oldhdc = SelectObject(memdc, LoadedPics(tmp).Handle)

Curpos = 1

For X = StartThumb To EndThumb

ret = StretchBlt(Ownerform.hdc, Me.Pos_Left, Me.Pos_Top, Me.Pos_Width, Pos_Height, memdc, 1, Curpos, Me.Thum_Width, Me.Thum_Height, SRCCOPY)

If Me.ProjectTo = 0 Then ProjectTo = GetDC(0)
If Me.ProjectOn = True Then ret = StretchBlt(Me.ProjectTo, Me.Pos_Left, Me.Pos_Top, Me.Pos_Width, Pos_Height, memdc, 1, Curpos, Me.Thum_Width, Me.Thum_Height, SRCCOPY)


Curpos = Curpos + Me.Thum_Height

For xtmer = 1 To 3000
If Stop_Film = True Then Exit Function: xtmer = 3000
DoEvents
Next         '// Will need to come up with something for this.

'DoEvents
Next X


DeleteDC memdc
ReleaseDC Ownerform.hwnd, hdc

Next tmp

If Me.AutoRepeat = True Then Me.Roll_Tape


'BOOL StretchBlt(hdcDest, nXOriginDest, nYOriginDest, nWidthDest, nHeightDest, hdcSrc, nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc, fdwRop)
'HDC hdcDest;    /* destination device-context handle    */
'int nXOriginDest;   /* x-coordinate of origin of destination rectangle  */
'int nYOriginDest;   /* y-coordinate of origin of destination rectangle  */
'int nWidthDest; /* width of destination rectangle   */
'int nHeightDest;    /* height of destination rectangle  */
'HDC hdcSrc; /* source device-context handle */'
'int nXOriginSrc;    /* x-coordinate of origin of source rectangle   */
'int nYOriginSrc;    /* y-coordinate of origin of source rectangle   */
'int nWidthSrc;  /* width of source rectangle    */
'int nHeightSrc; /* height of source rectangle   */
'DWORD fdwRop;   /* raster operation */

End Function




Sub Init_ImageData()

For X = 1 To Loaded_Count
ReDim Preserve LoadedPics(X)
Set LoadedPics(X) = LoadPicture(ThumbPics(X))
Next X
End Sub


Sub Stop_()
Stop_Film = True
End Sub

Sub Unload_VCR()
For t = 1 To Loaded_Count
Set LoadedPics(t) = Nothing

Next t
Stop_Film = True
Erase LoadedPics
End Sub

